home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATH_LIB / MATHLIB.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-29  |  3KB  |  136 lines
  1. Unit MATHLIB;
  2.  
  3. (* Bibliotheque mathematique pour type real *)
  4. (* JD GAYRARD fev 94 *)
  5. (* la bibliotheque est batie à partir des fonctions : *)
  6. (* ARCTAN, COS, EXP, LN, SIN, SQRT *)
  7. (* elle fournit les fonctions : *)
  8. (* ARCCOS, ARCSIN, ARCTAN2, LOG, TAN *)
  9. (* PUISSANCE, SIGNE, MAX, MIN, MODULO *)
  10.  
  11.  
  12. interface
  13.  
  14. const pi_sur_2 = pi / 2.0;
  15.       log10E = 0.434294481903;
  16.  
  17. function tan(x : real): real;
  18. function arcsin(x : real): real;
  19. function arccos(x : real): real;
  20. function arctan2(x, y : real): real;
  21. function log(x : real): real;
  22. function puissance( x, n : real): real;
  23. function modulo( x, m : real): real;
  24. function signe(x, y : real): real;
  25. function max(x, y : real): real;
  26. function min(x, y : real): real;
  27.  
  28. implementation
  29.  
  30. function signe(x, y : real): real;
  31. (* retourne x avec le signe de y *)
  32. begin
  33. if x > 0.0 then if y > 0.0 then signe := x
  34.                            else signe := -x
  35.            else if y < 0.0 then signe := x
  36.                            else signe := -x
  37. end;
  38.  
  39. function min(x, y : real): real;
  40. (* retourne le plus petit *)
  41. begin
  42. if x > y then min := y
  43.          else min := x
  44. end;
  45.  
  46. function max(x, y : real): real;
  47. (* retourne le plus grand *)
  48. begin
  49. if x < y then max := y
  50.          else max := x
  51. end;
  52.  
  53. function tan(x : real): real;
  54. (* retourne la tangente de x (en radian) *)
  55. var sinx, cosx :real;
  56. begin
  57. sinx := sin(x);
  58. cosx := cos(x);
  59. if cosx = 0.0
  60.    then begin
  61.         writeln('******* Fonction tan ********');
  62.         writeln('********* OVERFLOW **********');
  63.         halt
  64.         end
  65.    else tan := sinx / cosx
  66. end;
  67.  
  68. function arcsin(x : real): real;
  69. begin
  70. if (x > 1.0) or (x < -1.0)
  71.    then begin
  72.         writeln('****** Fonction arcsin ******');
  73.         writeln('********* OVERFLOW **********');
  74.         halt
  75.         end
  76.    else if x = 0.0
  77.            then arcsin := 0.0
  78.            else if x = 1.0
  79.                    then arcsin := pi_sur_2
  80.                    else if x = -1.0
  81.                            then arcsin := - pi_sur_2
  82.                            else arcsin := arctan(x / sqrt( 1.0 - x * x))
  83. end;
  84.  
  85. function arccos(x : real): real;
  86. var y : real;
  87. begin
  88. if (x > 1.0) or (x < -1.0)
  89.    then begin
  90.         writeln('****** Fonction arccos ******');
  91.         writeln('********* OVERFLOW **********');
  92.         halt
  93.         end
  94.    else if x = 0.0
  95.            then arccos := pi_sur_2
  96.            else if x = 1.0
  97.                 then arccos := 0.0
  98.                 else if x = -1.0
  99.                         then arccos := pi
  100.                         else begin
  101.                              y := arctan(sqrt( 1.0 - x * x) / x);
  102.                              if x > 0.0
  103.                                 then arccos := y
  104.                                 else arccos := y + pi;
  105.                              end
  106. end;
  107.  
  108. function arctan2(x, y : real): real;
  109. begin
  110. if x = 0.0
  111.    then arctan2 := signe(pi_sur_2, y)
  112.    else if x > 0.0
  113.         then arctan2 := arctan(y/x)
  114.         else arctan2 := arctan(y/x) + signe(pi,y)
  115. end;
  116.  
  117.  
  118. function puissance( x, n : real): real;
  119. begin
  120. puissance := exp( n * ln(x))
  121. end;
  122.  
  123. function modulo(x, m : real): real;
  124. begin
  125. while x < 0 do x := x + m;
  126. while x > m do x := x - m;
  127. modulo := x
  128. end;
  129.  
  130. function log(x : real): real;
  131. begin
  132. log := log10E * ln(x)
  133. end;
  134.  
  135. end.
  136.